home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Internet Strate…Tools for the Enterprise / Microsoft Internet Strategy & Tools for the Enterprise.iso / content / devel.tls / icp / vbsamp / smplhttp.exe / FRMHTTP.FRM (.txt) next >
Visual Basic Form  |  1996-03-28  |  13KB  |  257 lines
  1. VERSION 4.00
  2. Begin VB.Form frmHTTP 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Simple HTTP..."
  5.    ClientHeight    =   5805
  6.    ClientLeft      =   855
  7.    ClientTop       =   1140
  8.    ClientWidth     =   8130
  9.    Height          =   6210
  10.    Icon            =   "frmHTTP.frx":0000
  11.    Left            =   795
  12.    LinkTopic       =   "Form1"
  13.    LockControls    =   -1  'True
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   5805
  16.    ScaleWidth      =   8130
  17.    ShowInTaskbar   =   0   'False
  18.    Top             =   795
  19.    Width           =   8250
  20.    Begin VB.TextBox txtFileName 
  21.       Height          =   285
  22.       Left            =   720
  23.       TabIndex        =   6
  24.       Top             =   390
  25.       Width           =   6255
  26.    End
  27.    Begin VB.ComboBox cmbURL 
  28.       Height          =   315
  29.       Left            =   720
  30.       TabIndex        =   1
  31.       Text            =   "http://www.microsoft.com/"
  32.       Top             =   30
  33.       Width           =   6255
  34.    End
  35.    Begin VB.TextBox txtDocument 
  36.       Height          =   4785
  37.       Left            =   0
  38.       MultiLine       =   -1  'True
  39.       ScrollBars      =   3  'Both
  40.       TabIndex        =   4
  41.       Top             =   720
  42.       Width           =   8130
  43.    End
  44.    Begin VB.Label Label1 
  45.       AutoSize        =   -1  'True
  46.       Caption         =   "File:"
  47.       Height          =   195
  48.       Index           =   1
  49.       Left            =   420
  50.       TabIndex        =   5
  51.       Top             =   420
  52.       Width           =   285
  53.    End
  54.    Begin HTTPCTLib.HTTPCT HTTP 
  55.       Left            =   7890
  56.       Top             =   720
  57.       _ExtentX        =   847
  58.       _ExtentY        =   847
  59.       RemoteHost      =   "127.0.0.1"
  60.       RemotePort      =   80
  61.       ConnectTimeout  =   0
  62.       RecvTimeout     =   0
  63.       NotificationMode=   1
  64.       Document        =   ""
  65.       Method          =   1
  66.    End
  67.    Begin ComctlLib.ImageList Images 
  68.       Left            =   7890
  69.       Top             =   1110
  70.       _Version        =   65536
  71.       _ExtentX        =   1005
  72.       _ExtentY        =   1005
  73.       _StockProps     =   1
  74.       BackColor       =   -2147483643
  75.       ImageWidth      =   16
  76.       ImageHeight     =   16
  77.       MaskColor       =   12632256
  78.       NumImages       =   3
  79.       i1              =   "frmHTTP.frx":0442
  80.       i2              =   "frmHTTP.frx":0641
  81.       i3              =   "frmHTTP.frx":0840
  82.    End
  83.    Begin ComctlLib.Toolbar Tools 
  84.       Height          =   390
  85.       Left            =   7035
  86.       TabIndex        =   3
  87.       Top             =   30
  88.       Width           =   1125
  89.       _Version        =   65536
  90.       _ExtentX        =   1984
  91.       _ExtentY        =   688
  92.       _StockProps     =   96
  93.       ImageList       =   "Images"
  94.       AllowCustomize  =   0   'False
  95.       NumButtons      =   3
  96.       i1              =   "frmHTTP.frx":0A3F
  97.       i2              =   "frmHTTP.frx":0BF2
  98.       i3              =   "frmHTTP.frx":0D9D
  99.       AlignSet        =   -1  'True
  100.    End
  101.    Begin VB.Label Label1 
  102.       AutoSize        =   -1  'True
  103.       Caption         =   "Address:"
  104.       Height          =   195
  105.       Index           =   0
  106.       Left            =   90
  107.       TabIndex        =   0
  108.       Top             =   90
  109.       Width           =   615
  110.    End
  111.    Begin ComctlLib.StatusBar Status 
  112.       Align           =   2  'Align Bottom
  113.       Height          =   270
  114.       Left            =   0
  115.       TabIndex        =   2
  116.       Top             =   5535
  117.       Width           =   8130
  118.       _Version        =   65536
  119.       _ExtentX        =   14340
  120.       _ExtentY        =   476
  121.       _StockProps     =   68
  122.       AlignSet        =   -1  'True
  123.       SimpleText      =   ""
  124.       NumPanels       =   3
  125.       i1              =   "frmHTTP.frx":0F48
  126.       i2              =   "frmHTTP.frx":1015
  127.       i3              =   "frmHTTP.frx":10E2
  128.    End
  129. Attribute VB_Name = "frmHTTP"
  130. Attribute VB_Creatable = False
  131. Attribute VB_Exposed = False
  132. Option Explicit
  133. '------------------------------------------------------------
  134. Dim httpDoc As String                                   ' HTTP document download variable
  135. Const btnRETRIEVE = 1                                   ' Toolbar button constant - Document retrieve button
  136. Const btnHALT = 2                                       ' Toolbar button constant - Halt retrieve button
  137. Const btnPOST = 3                                       ' Toolbar button constant - Post Document\File button
  138. '------------------------------------------------------------
  139. '------------------------------------------------------------
  140. Private Sub cmbURL_KeyDown(KeyCode As Integer, Shift As Integer)
  141. '------------------------------------------------------------
  142.     If (KeyCode = vbKeyReturn) Then                     ' If user hit enter key...
  143.         Tools_ButtonClick Tools.Buttons(btnRETRIEVE)    ' Click Retrieve button
  144.     End If
  145. '------------------------------------------------------------
  146. End Sub
  147. '------------------------------------------------------------
  148. '------------------------------------------------------------
  149. Private Sub Form_Load()
  150. '------------------------------------------------------------
  151.     Status.Panels(1).Text = HTTP.StateString            ' Display HTTP state
  152.     Status.Panels(2).Text = HTTP.ProtocolStateString    ' Display HTTP protocol state
  153. '------------------------------------------------------------
  154. End Sub
  155. '------------------------------------------------------------
  156. '------------------------------------------------------------
  157. Private Sub HTTP_DocInput(ByVal DocInput As DocInput)
  158. '------------------------------------------------------------
  159.     Select Case DocInput.State                          ' Determine state of HTTP upload
  160.     Case icDocBegin                                     ' Beginning upload
  161.     Case icDocHeaders                                   ' Uploading MIME-headers
  162.     Case icDocData                                      ' Uploading data
  163.         Status.Panels(3).Text = "Sending Doc... [" & CStr(DocInput.BytesTransferred) & _
  164.                                           "] of [" & CStr(DocInput.BytesTotal) & "]" ' Display transfer status...
  165.     Case icDocEnd                                       ' Upload complete
  166.         Status.Panels(3).Text = ""                      ' Clear status
  167.     End Select
  168. '------------------------------------------------------------
  169. End Sub
  170. '------------------------------------------------------------
  171. '------------------------------------------------------------
  172. Private Sub HTTP_DocOutput(ByVal DocOutput As DocOutput)
  173. '------------------------------------------------------------
  174.     Dim i As Long                                       ' Loop variable
  175.     Dim Hdr As DocHeader                                ' Doc Header variable
  176.     Dim Data As String                                  ' Data download variable
  177. '------------------------------------------------------------
  178.     Select Case DocOutput.State                         ' Determine current state of download
  179.     Case icDocBegin                                     ' Beginning download
  180.         httpDoc = ""                                    ' Clear HTTP data variable
  181.         txtDocument.Text = ""                           ' Clear output textbox
  182.     Case icDocHeaders                                   ' Downloading MIME-Headers
  183.         httpDoc = httpDoc & "= Begin Headers ========================================" & vbCrLf
  184.         For Each Hdr In DocOutput.Headers
  185.             httpDoc = httpDoc & Hdr.Name & ": " & Hdr.Value & vbCrLf
  186.         Next
  187.         httpDoc = httpDoc & "= End Headers ==========================================" & vbCrLf
  188.     Case icDocData                                      ' Downloading data
  189.         Status.Panels(3).Text = "Getting Doc... [" & CStr(DocOutput.BytesTransferred) & _
  190.                                           "] of [" & CStr(DocOutput.BytesTotal) & "]" ' Display download status
  191.         DocOutput.GetData Data                          ' Get data from DocOutput object
  192.         httpDoc = httpDoc & Data                        ' Save data
  193.     Case icDocEnd                                       ' Download complete
  194.         If (httpDoc <> "") Then                         ' If data was received...
  195.             txtDocument.Text = httpDoc                  ' Display output
  196.             Status.Panels(3).Text = ""                  ' Clear status
  197.             httpDoc = ""                                ' Clear data variable
  198.             cmbURL.Text = HTTP.URL                      ' Display updated\resolved URL
  199.             For i = 0 To cmbURL.ListCount - 1           ' Search each entry in DropDownCombo
  200.                 If (cmbURL.List(i) = cmbURL.Text) Then Exit For ' If entry is duplicate then exit search
  201.             Next
  202.             If (i >= cmbURL.ListCount) Then cmbURL.AddItem HTTP.URL ' if item was not found then update DropDownCombo.
  203.         End If
  204.     Case Else                                           ' Handle [Errors, etc...]
  205.         Status.Panels(3).Text = ""                      ' Clear status
  206. '       httpDoc = ""                                    ' Clear data variable
  207.     End Select
  208. '------------------------------------------------------------
  209. End Sub
  210. '------------------------------------------------------------
  211. '------------------------------------------------------------
  212. Private Sub HTTP_ProtocolStateChanged(ByVal ProtocolState As Integer)
  213. '------------------------------------------------------------
  214.     Status.Panels(2).Text = HTTP.ProtocolStateString    ' Display protocol state
  215. '------------------------------------------------------------
  216. End Sub
  217. '------------------------------------------------------------
  218. '------------------------------------------------------------
  219. Private Sub HTTP_StateChanged(ByVal State As Integer)
  220. '------------------------------------------------------------
  221.     Status.Panels(1).Text = HTTP.StateString            ' Display state
  222.     Select Case State                                   ' Determine current state
  223.     Case prcDisconnected                                ' Disconnected from server
  224.         Screen.MousePointer = vbDefault                 ' Show default pointer - transaction done.
  225.     Case Else
  226.         Screen.MousePointer = vbHourglass               ' Not disconnected show that HTTP client is busy...
  227.     End Select
  228. '------------------------------------------------------------
  229. End Sub
  230. '------------------------------------------------------------
  231. '------------------------------------------------------------
  232. Private Sub Tools_ButtonClick(ByVal Button As Button)
  233. '------------------------------------------------------------
  234.     Dim Hdrs As DocHeaders                              ' Headers collection variable
  235.     Dim URL As String                                   ' URL variable
  236.     Dim Pos As Long                                     ' Substring position variable
  237. '------------------------------------------------------------
  238.     Select Case Button.Index                            ' Determine which button was pushed
  239.     Case btnRETRIEVE                                    ' Retrieve document button
  240.         URL = LCase(cmbURL.Text)                        ' Set url to all lowercase
  241.         If (Mid(URL, 1, 7) <> "http://") Then URL = "http://" & URL ' If HTTP prefix is missing then add it.
  242.         Pos = InStr(8, URL, "/")                        ' Search for proper HTTP suffix.
  243.         If (Pos < 1) Then URL = URL & "/"               ' If suffix not found then add it.
  244.         HTTP.GetDoc URL                                 ' Get URL document from HTTP server
  245.     Case btnHALT                                        ' Halt retrieve button
  246.         HTTP.Cancel                                     ' Halt\Cancel current transaction
  247.     Case btnPOST                                        ' Post document\file button
  248. '       Set Hdrs = HTTP.DocInput.Headers                ' Set pointer to headers collection
  249. '       Hdrs.Clear                                      ' Clear any members of headers collection
  250. '       Hdrs.Add "", ""                                 ' Add MIME-header to headers collection
  251. '       HTTP.SendDoc cmbURL.Text, Hdrs, , txtFileName.Text ' Post file with MIME-headers to URL...
  252.         HTTP.SendDoc cmbURL.Text, , , txtFileName.Text  ' Post file to URL...
  253.     End Select
  254. '------------------------------------------------------------
  255. End Sub
  256. '------------------------------------------------------------
  257.